home *** CD-ROM | disk | FTP | other *** search
/ User's Choice Windows CD / User's Choice Windows CD (CMS Software)(1993).iso / windows4 / plx17.zip / PRINTER.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-14  |  11KB  |  435 lines
  1. unit Printer; {Unit by Doug Overmyer 11/91 update 6/1/92}
  2. {********************  Interface   ************************}
  3. Interface
  4.  
  5. uses WinTypes, WinProcs,WObjects,Strings,Win31,CommDlg;
  6. const
  7.     id_ChgPrnDlgOK       =  2599;
  8.   id_ChgPrnDlgLB1      =  2598;
  9.  
  10. type
  11. PAbortDlg = ^TAbortDlg;
  12. TAbortDlg = object(TDialog)
  13.     procedure Cancel(var Msg:TMessage);virtual id_First+id_Cancel;
  14. end;
  15.  
  16. type
  17. PChgPrnDlg = ^TChgPrnDlg;      {used by ChangePrinter()}
  18. TChgPrnDlg = object(TDialog)
  19.     AllDevicesBuf:Array[0..4096] of Char;
  20.   procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
  21.     procedure IDChgPrtDlgOK(var Msg:TMessage);virtual id_First+id_ChgPrnDlgOK;
  22. end;
  23.  
  24. type
  25. PPrinter = ^TPrinter;
  26. TPrinter = object(TObject)
  27.         PrintDC,PrintIC:HDC;
  28.       CurFont:HFont;
  29.       LineX,LineY:Integer; {line width and height for CurFont}
  30.       PageNumber:Integer;  {current page number}
  31.       Metrics:TTextMetric; {current text metrics}
  32.       EscResult:Integer;  {result of most recent ESC call}
  33.       CurX,CurY:Integer;  {print Cursor X,Y position in device units}
  34.       PageX,PageY:Integer;{page width and height in device units}
  35.       LogPixX,LogPixY:Integer; {pixels/inch}
  36.       Printing:Boolean;
  37.   constructor Init;
  38.   destructor Done;virtual;
  39.   function GetPrintDC:Boolean;virtual;
  40.   procedure GetPrnParms;virtual;
  41.   procedure InstallAbortProc;virtual;
  42.   procedure SetupPage;virtual;
  43.     function PrnStart(DocName:PChar):Boolean;virtual;
  44.     procedure NewPage;virtual;
  45.     procedure PrnStop;virtual;
  46.   function GetIC:HDC;virtual;
  47.   function  DeleteIC:Boolean;virtual;
  48.   function SetFont(NewFont:HFont):HFont;virtual;
  49.   procedure PrnDeviceMode(ParentWindow:PWindowsObject);virtual;
  50.   procedure ChangePrinter(ParentWindow:PwindowsObject);virtual;
  51. end;
  52.  
  53. PLPrinter = ^TLPrinter;
  54. TLPrinter = object(TPrinter)
  55.         Margin:TRect;  {margin in device units}
  56.       FooterY:Integer; {height of footer in device units}
  57.       IsFooter:Boolean;  {True = is printing footer}
  58.   constructor Init;
  59.   procedure PrintLine(aString:PChar);virtual;
  60.   procedure PrnStop;virtual;
  61.   procedure CheckNewPage;virtual;
  62.   procedure DoHeader;virtual;
  63.   procedure DoFooter;virtual;
  64.   procedure SetupPage;virtual;
  65.   procedure SetTOP;virtual;
  66.   procedure SetMarginL(NewMargin:Integer);virtual;
  67.   procedure SetMarginR(NewMargin:Integer);virtual;
  68.   procedure SetMarginT(NewMargin:Integer);virtual;
  69.   procedure SetMarginB(NewMargin:Integer);virtual;
  70. end;
  71. {to use a TLPrinter object, call
  72.     0. Subclass DoHeader,DoFooter properly
  73.     1. New.....Init
  74.   2. PrtStart
  75.   3. SetMarginL, SetFont, etc. Also set FooterY as needed.
  76.   4. SetupPage  (does the DoHeader if any)
  77.   5. printLine  (as needed)
  78.   6. DoFooter, PrnStop (do one last footer before stopping)
  79.   7. SetFont (if needed to restore 'old font')
  80.   8. Dispose
  81. alternative - to get a PrintDC only
  82.     1. New...Init
  83.   2. GetIC
  84.   3.  use the IC, TextMetrics, other info, but NO drawing/printing
  85.   4. DeleteIC
  86.   5. Dispose
  87. }
  88. {**********************  Implementation    *********************}
  89. Implementation
  90. {$R printer.res}
  91. {*********************    Globals & Functions    *********************}
  92. var
  93.     Aborted:Boolean;
  94.   AbortDlg:PAbortDlg;
  95.   PAbortProc:TFarProc;
  96.  
  97. function AbortProc(PrtDC:HDC;Code:Integer):Boolean;export;
  98. var
  99.     Msg:TMsg;
  100. begin
  101.     while (not Aborted) and (AbortDlg^.HWindow <> 0) and
  102.               PeekMessage(Msg,0,0,0,pm_Remove) do
  103.       if not IsDialogMessage(AbortDlg^.HWindow,Msg) then
  104.         begin
  105.       translateMessage(Msg);
  106.       DispatchMessage(Msg);
  107.       end;
  108.   AbortProc := not Aborted;
  109. end;
  110.  
  111. {***************************************************************}
  112. constructor TPrinter.Init;
  113. begin
  114.     TObject.Init;
  115.   PrintDC := 0;PrintIC := 0;
  116.   CurX := 0;
  117.   CurY := 0;
  118.   Aborted := False;
  119.   CurFont := GetStockObject(Device_Default_Font);
  120.   PageNumber := 1;
  121. end;
  122.  
  123. destructor TPrinter.Done;
  124. begin
  125.     TObject.Done;
  126. end;
  127.  
  128. function TPrinter.PrnStart(DocName:PChar):Boolean;
  129. var
  130.     DI:TDocInfo;
  131. begin
  132.     GetPrintDC;
  133.   With DI do
  134.       begin
  135.     cbSize := sizeOf(TDocInfo);
  136.     lpSzDocName := DocName;
  137.     lpSzOutput := nil;
  138.     end;
  139.   If PrintDC <> 0 then
  140.       begin
  141.     GetPrnParms;
  142.     InstallAbortProc;
  143.     if EscResult > 0 then
  144.         begin
  145.       EscResult := StartDoc(PrintDC,DI);
  146.         Printing := (EscResult > 0);
  147.       StartPage(PrintDC);
  148.       end;
  149.     end
  150.   else
  151.       Printing := false;
  152.   If not Printing then
  153.       begin
  154.     if AbortDlg <> nil then
  155.             AbortDlg^.CloseWindow;
  156.     MessageBox(Application^.MainWindow^.HWindow,'Printer Initialization Failed',
  157.         'Error',mb_IconExclamation or mb_OK);
  158.     end;
  159.   PrnStart := Printing;
  160. end;
  161.  
  162. function TPrinter.GetPrintDC;
  163. var
  164.   PD:TPrintDlg;
  165. begin
  166.   with PD do
  167.       begin
  168.     lStructSize := sizeof(TPrintDlg);
  169.     hWndOwner := 0;
  170.     hDevMode := THandle(nil);
  171.     hDevNames := THandle(nil);
  172.     hDC := 0;
  173.     Flags := PD_RETURNDC OR PD_RETURNDEFAULT;
  174.     hInstance := THandle(nil);
  175.     nCopies := 1;
  176.     end;
  177.   PrintDlg(PD);
  178.   PrintDC := PD.hDc;
  179.     If PD.hDevMode > 0 then GlobalFree(PD.hDevMode);
  180.   if PD.hDevNames > 0 then GlobalFree(PD.hDevNames);
  181.   GetPrintDC := (PrintDC > 0);
  182. end;
  183.  
  184. procedure TPrinter.GetPrnParms;
  185. begin
  186.     GetTextMetrics(PrintDC,Metrics);
  187.   LogPixX := GetDeviceCaps(PrintDC,LogPixelsX);
  188.   LogPixY := GetDeviceCaps(PrintDC,LogPixelsY);
  189.   PageX := GetDeviceCaps(PrintDC,HorzRes);
  190.   PageY := GetDeviceCaps(PrintDC,VertRes);
  191.   LineY := Metrics.tmHeight + Metrics.tmExternalLeading;
  192. end;
  193.  
  194. procedure TPrinter.InstallAbortProc;
  195. begin
  196.     AbortDlg := new(PAbortDlg,Init(Application^.MainWindow,
  197.           'AbortDlg'));
  198.   AbortDlg^.EnableAutoCreate;
  199.   Application^.MakeWindow(AbortDlg);
  200.     PAbortProc := MakeProcInstance(@AbortProc,HInstance);
  201.   EscResult := SetAbortProc(PrintDC,TAbortProc(PAbortProc));
  202. end;
  203.  
  204. procedure TPrinter.SetupPage;
  205. begin
  206.     {Formal method}
  207. end;
  208.  
  209. procedure TPrinter.NewPage;
  210. begin
  211.     if Printing and (EscResult > 0) then
  212.     EscResult := EndPage(PrintDC);
  213.   StartPage(PrintDC);
  214.   SelectObject(PrintDC,CurFont);
  215.   Inc(PageNumber);
  216. end;
  217.  
  218. procedure TPrinter.PrnStop;
  219. begin
  220.     if Printing then
  221.       begin
  222.     if AbortDlg <> nil then
  223.         AbortDlg^.CloseWindow;
  224.       if EscResult > 0 then
  225.       EndDoc(PrintDC);
  226.     DeleteDC(PrintDC);
  227.     Printing := false;
  228.     end;
  229. end;
  230.  
  231. function TPrinter.GetIC:HDC;
  232. var
  233.   PD:TPrintDlg;
  234. begin
  235.   with PD do
  236.       begin
  237.     lStructSize := sizeof(TPrintDlg);
  238.     hWndOwner := 0;
  239.     hDevMode := THandle(nil);
  240.     hDevNames := THandle(nil);
  241.     hDC := 0;
  242.     Flags := PD_RETURNIC OR PD_RETURNDEFAULT;
  243.     hInstance := THandle(nil);
  244.     nCopies := 1;
  245.     end;
  246.   PrintDlg(PD);
  247.   PrintIC := PD.hDc;
  248.   GetTextMetrics(PrintIC,Metrics);
  249.   LogPixX := GetDeviceCaps(PrintIC,LogPixelsX);
  250.   LogPixY := GetDeviceCaps(PrintIC,LogPixelsY);
  251.   PageX := GetDeviceCaps(PrintIC,HorzRes);
  252.   PageY := GetDeviceCaps(PrintIC,VertRes);
  253.   LineY := Metrics.tmHeight + Metrics.tmExternalLeading;
  254.     If PD.hDevMode > 0 then GlobalFree(PD.hDevMode);
  255.   if PD.hDevNames > 0 then GlobalFree(PD.hDevNames);
  256.   GetIC:= PrintIC;
  257. end;
  258.  
  259. function TPrinter.DeleteIC;
  260. begin
  261.     DeleteIC := (PrintIC > 0);
  262.     if PrintDC > 0 then
  263.     DeleteDC(PrintIC);
  264.   PrintIC := 0;
  265. end;
  266.  
  267. function TPrinter.SetFont(NewFont:HFont):HFont;
  268. begin
  269.     SetFont :=SelectObject(PrintDC,NewFont);
  270.   CurFont := NewFont;
  271.   GetPrnParms;
  272. end;
  273.  
  274. procedure TPrinter.PrnDeviceMode(ParentWindow:PWindowsObject);
  275. var
  276.   PD:TPrintDlg;
  277. begin
  278.   with PD do
  279.       begin
  280.     lStructSize := sizeof(TPrintDlg);
  281.     hWndOwner := ParentWindow^.HWindow;
  282.     hDevMode := THandle(nil);
  283.     hDevNames := THandle(nil);
  284.     Flags := PD_PRINTSETUP;
  285.     hInstance := THandle(nil);
  286.     nCopies := 1;
  287.     end;
  288.     PrintDlg(PD);
  289. end;
  290.  
  291. procedure TPrinter.ChangePrinter(ParentWindow:PWindowsObject);
  292. var
  293.     ChgPrnDlg:PChgPrnDlg;
  294. begin
  295.     ChgPrnDlg := New(PChgPrnDlg,Init(Parentwindow,'ChgPrnDlg'));
  296.   Application^.ExecDialog(ChgPrnDlg); 
  297. end;
  298.  
  299. {*********************  TAbortDlg  **********************}
  300. procedure TAbortDlg.Cancel(var Msg:TMessage);
  301. begin
  302.     Aborted := True;
  303.   TDialog.Cancel(Msg);
  304. end;
  305.  
  306. {********************  TChgPrnDlg   ************************}
  307. procedure TChgPrnDlg.WMInitDialog(var Msg:TMessage);
  308. var
  309.      pAllDevicesBuf:PChar;
  310.      Buf:Array[0..64] of Char;
  311.      pBuf:PChar;
  312.      Printer1:Array[0..64] of Char;
  313.      Printer:Array[0..64] of Char;
  314.     pPrinter:PChar;
  315. begin
  316.     GetProfileString('devices',nil,'',AllDevicesBuf,sizeof(AllDevicesBuf));
  317.     TDialog.WMInitDialog(Msg);
  318.   pAllDevicesBuf := AllDevicesBuf;
  319.   pBuf := @Buf;
  320.   pPrinter := @Printer;
  321.   repeat
  322.     StrCopy(Buf,pAllDevicesBuf);
  323.     GetProfileString('devices',Buf,'',Printer1,sizeof(Printer1));
  324.     StrCat(StrCat(StrCopy(Printer,Buf),','),Printer1);
  325.       SendDlgItemMsg(id_ChgPrnDlgLB1,lb_AddString,word(0),LongInt(pPrinter));
  326.     pAllDevicesbuf := pAllDevicesBuf+StrLen(pBuf)+1;
  327.   until StrLen(pAllDevicesBuf) = 0;
  328. end;
  329.  
  330. procedure TChgPrnDlg.IDChgPrtDlgOK(var Msg:TMessage);
  331. var
  332.     Idx:Integer;
  333.   Buf:Array[0..64] of Char;
  334.   Ptr:PChar;
  335.   NewDevice:Array[0..64] of Char;
  336. begin
  337.     StrCopy(Buf,'');
  338.     Ptr := @Buf;
  339.   Idx := SendDlgItemMsg(id_ChgPrnDlgLB1,lb_GetCurSel,0,0);
  340.   if Idx <> lb_Err then
  341.       SendDlgItemMsg(id_ChgPrnDlgLB1,lb_GetText,idx,Longint(Ptr));
  342.   if StrLen(Ptr) > 0 then
  343.       begin
  344.     StrCopy(NewDevice,Buf);
  345.     WriteProfileString('Windows','device',NewDevice);
  346.     end;
  347.     EndDlg(1);
  348. end;
  349.  
  350. {**********************  TLPrinter    ************************}
  351. constructor TLPrinter.Init;
  352. begin
  353.     TPrinter.Init;
  354.   Margin.Left := 0;
  355.   Margin.Right := 0;
  356.   Margin.Top := 0;
  357.   Margin.Bottom := 0;
  358.   FooterY := 0;
  359.   IsFooter := False;
  360. end;
  361.  
  362. procedure TLPrinter.PrintLine(aString:PChar);
  363. begin
  364.   CurX := Margin.Left;
  365.     TextOut(PrintDC,CurX,CurY,aString,StrLen(aString));
  366.   CurY := CurY + LineY;
  367.   CurX := Margin.Left;
  368.   if not IsFooter then
  369.       CheckNewPage;
  370. end;
  371.  
  372. procedure TLPrinter.PrnStop;
  373. begin
  374.     if CurY > Margin.Top then
  375.       NewPage;
  376.   TPrinter.PrnStop;
  377. end;
  378.  
  379. procedure TLPrinter.CheckNewPage;
  380. begin
  381.     if (CurY + Margin.Bottom + 2*LineY + FooterY ) > PageY then
  382.       begin
  383.     IsFooter := True;
  384.       DoFooter;
  385.     IsFooter := False;
  386.     NewPage;
  387.     SetupPage;
  388.     end;
  389. end;
  390.  
  391. procedure TLPrinter.DoHeader;
  392. begin
  393.     {formal method}
  394. end;
  395.  
  396. procedure TLPrinter.DoFooter;
  397. begin
  398.     IsFooter := True;
  399.   {Include this code when you subclass DoFooter}
  400.   IsFooter := False;
  401. end;
  402.  
  403. procedure TLPrinter.SetupPage;
  404. begin
  405.     SetTOP;
  406.   DoHeader;
  407. end;
  408.  
  409. procedure TLPrinter.SetTOP;
  410. begin
  411.     CurX := Margin.Left;
  412.   CurY := Margin.Top;
  413. end;
  414.  
  415. procedure TLPrinter.SetMarginL(NewMargin:Integer);
  416. begin
  417.     Margin.Left := NewMargin;
  418. end;
  419.  
  420. procedure TLPrinter.SetMarginR(NewMargin:Integer);
  421. begin
  422.     Margin.Right := NewMargin;
  423. end;
  424.  
  425. procedure TLPrinter.SetMarginT(NewMargin:Integer);
  426. begin
  427.     Margin.Top := NewMargin;
  428. end;
  429.  
  430. procedure TLPrinter.SetMarginB(NewMargin:Integer);
  431. begin
  432.     Margin.Bottom := NewMargin;
  433. end;
  434. {***************************************************************}
  435. end.